%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% The definition of dclient.oz

% Authors: Peter Van Roy and Seif Haridi
% May 9, 2003

% It is a bit longish (almost 100 lines) because of the procedure
% TryToConnect, which handles the different possibilities that arise when
% a client tries to connect to a server.  TryToConnect implements a
% graphic user interface that asks the client's user what to do in each
% case.

functor
import Application Connection Module Pickle Fault Guard QTk
define
   Args={Application.getArgs
         record('in'(single type:string)
                connect(single type:string))}
   
   UCell={NewCell Args.connect}
   PCell={NewCell unit}
      
   proc {TryToConnect FNURL}
      try
         P={Connection.take {Pickle.load FNURL}}
      in
         UCell:=FNURL
         PCell:=P
      catch _ then H R D W in
         D=td(title:"Server is down!"
              action:proc {$} R=tryagain {W close} end
              td(label(init:"Please choose an option")
                 lrline(glue:we))
              td(padx:5 pady:5 glue:ew
                 button(text:"Try connecting again" glue:ew pady:5
                        action:proc {$} R=tryagain {W close} end)
                 lr(glue:ew pady:5
                    button(text:"Try connecting with new URL:" glue:e
                           action:proc {$} R=trynewurl({H get($)})
                                     {W close} end)
                    entry(init:@UCell glue:ew handle:H))
                 button(text:"Keep trying forever" glue:ew pady:5
                        action:proc {$} R=tryforever {W close} end)
                 button(text:"Quit client" glue:ew
                        action:proc {$} R=quit {W close} end)))
         W={QTk.build D}
         {W show}
         {Wait R}
         case R
         of tryagain then
            {TryToConnect FNURL}
         [] trynewurl(NewURL) then
            {TryToConnect NewURL}
         [] tryforever then
            D2=td(title:"Trying to reconnect with server..."
                  td(padx:50 pady:10
                     button(text:"Cancel trying to reconnect"
                            glue:ew pady:10 action:toplevel#close)
                     button(text:"Quit client" glue:ew
                            action:proc {$}
                                      {Application.exit 0} end)))
            W2={QTk.build D2}
            GoOn={NewCell true}
            proc {LoopForever FNURL} 
               {Delay 1000}
               try
                  P={Connection.take {Pickle.load FNURL}}
               in
                  UCell:=FNURL
                  PCell:=P
               catch _ then
                  if @GoOn then {LoopForever FNURL}
                  else {W2 close} {TryToConnect FNURL} end
               end
               {W2 close}
            end
         in
            thread {W2 show(wait:true)} GoOn:=false end
            {LoopForever @UCell}
         [] quit then
            {Application.exit 0}
         else skip end
      end
   end
   
   {TryToConnect @UCell}
   
   [Client]={Module.link [Args.'in']}
   Q=Client.server
   R={CondSelect Client reconnect proc {$} skip end}
   
   proc {Q M}
      Sync P U in
      {Fault.enable Sync 'thread'(this) nil _}
      U=@UCell
      P=@PCell
      {Guard.guard P [permFail]
       proc {$}
          {Send P M#Sync}
          if Sync==unit then skip else raise Sync end end
       end
       proc {$} {TryToConnect U} {R} {Q M} end}
   end
end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
